home *** CD-ROM | disk | FTP | other *** search
Wrap
/* createhtml.frx * Copyright © 1998 Nils Bandener * $VER: createhtml_frx 8.9 (31.7.98) */ /* Please specify here a name for the ARexx script: */ scriptname = "Create HTML" /* * Script settings * * Edit the following lines to change the output * */ linesperpage = 30 /* Lines that should be written per page */ starttemplatefile = "tpl1.html" /* HTML file that is used as format template */ endtemplatefile = "tpl2.html" /* HTML file that is used as format template */ markercolor = "#000099" /* Color for the markers in front of the lines */ bgcolor = "#cccccc" /* Background color */ titlebgcolor = "#aaaaaa" /* Background color of table title */ titletxcolor = "#000000" /* Text color of table title */ mlname = "Fiasco MLArchive Example" /* Name of mailing list */ Options Results Parse Arg dir /* * If not called from Fiasco, try to address the active * Fiasco project */ if ~abbrev(address(), "FIASCO.") then do /* Get list of all available ports */ ports = show("Ports") /* Search for a port of Fiasco */ do i = 1 to words(ports) if abbrev(word(ports, i), "FIASCO.") then do /* A port of Fiasco has been found. * Now query Fiasco to return the port * name of the active database. */ Address Value word(ports, i) GetAttr Project Name Active ARexx Address Value Result break end end end fiasco_port = address() Signal on Syntax Signal on Halt Signal on Break_C Signal on Failure LockGUI /* * Request the directory in which * the output is written. * It is recommended to reserve a whole * directory for the output. * The first page can be referred then * by <directory>/index.html */ RequestFile 'drawersonly projectrelative savemode var dir' if rc = 0 then do if length(dir) ~= 0 & right(dir, 1) ~= ':' & right(dir, 1) ~= '/' then do dir = dir || "/" end /* * Sort the database by date and time */ sort 'date time index "mlahtml.fidx"' if rc = 0 then do countrecords 'var numrecs' /* * Calculator the number of pages */ numpages = trunc((numrecs / linesperpage) - 0.1) + 1 rootcnt = 0 /* * Search for "root" messages * which are not refered by other * messages */ do i = 1 to numrecs newsearchinfo 'name createhtmlsi' getfield 'reference record ' || i || ' var mid' setsearchfield 'searchinfo createhtmlsi fieldid messageid pattern ' || mid find 'searchinfo createhtmlsi record 0' if rc ~= 0 then do rootcnt = rootcnt + 1 /* Number of roots */ root.rootcnt = i /* Stem var with roots */ end end linecount = 0 activepage = 0 depth = 0 /* * Create the first index file */ call newlistfile /* * Now create output for each root * message. All other messages are * handled by printmail() */ do i = 1 to rootcnt depth = 0 /* for recursion with ARexx */ call printmail(root.i) end call closelistfile options failat 20 /* * Activate previous active index */ activeindex prev end end /*----------------------------------------------------* * * * Clean up functions * * * *----------------------------------------------------*/ bail_out: Address Value fiasco_port UnlockGUI ResetStatus exit syntax: failure: if show("Ports", fiasco_port) then do Address Value fiasco_port RequestChoice '"Error ' || rc || ' in line ' || sigl || ':*n' || errortext(rc) || '" "Cancel" Title "' || scriptname || '"' end else do say "Error" rc "in line" sigl ":" errortext(rc) say "Enter to continue" pull dummy end call bail_out halt: break_c: if show("Ports", fiasco_port) then do Address Value fiasco_port RequestChoice '"Script Abort Requested" "Abort Script" Title "' || scriptname || '"' end else do say "*** Break" say "Enter to continue" pull dummy end call bail_out /*----------------------------------------------------* * * * Create output for one mail * * * *----------------------------------------------------*/ /* * This function uses some tricks to do * recursion with ARexx. Stem variables are used * as the "stack". depth, as index for these variables, * is the "stack pointer". */ printmail: parse arg num depth = depth + 1 /* Get a new stack */ linecount = linecount + 1 /* * If number of lines exceeds the maximum * for an index page, start a new page */ if linecount > linesperpage then do linecount = 0 call newlistfile end /* * Read the data */ getfield 'subject record ' || num || ' var subject' getfield 'date record ' || num || ' extformat var dateval' getfield 'realname record ' || num || ' var realname' getfield 'messagekey record ' || num || ' var messagekey' getfield 'mailbody record ' || num || ' var mailbody' getfield 'email record ' || num || ' var emailval' /* * Write the mail file */ call writemailfile /* * Add a new line to the index page */ call writeln(f, "<tr>") leftspan = depth - 1 if leftspan > 6 then leftspan = 6 if leftspan ~= 0 then do call writeln(f, '<td colspan=' || leftspan || '></td>') end call writeln(f, '<td bgcolor="' || markercolor || '" width=10> </td>'); rightspan = 7 - leftspan call writeln(f, '<td colspan=' || rightspan || '>' || '<a href="' || messagekey || '.html">' || subject || '</a></td>') call writeln(f, '<td align=right>' || sizeval || '</td>') call writeln(f, '<td align=right>' || dateval || '</td>') call writeln(f, '<td>' || realname || '</td>') call writeln(f, '</tr>') /* * Search for referring mails */ getfield 'messageid record ' || num || ' var mid.' || depth if mid.depth ~= "" then do siname = 'createhtmlsi.' || depth newsearchinfo 'name ' || siname setsearchfield 'searchinfo ' || siname || ' fieldid reference pattern ' || mid.depth find 'searchinfo ' || siname || ' stem st.' || depth if rc = 0 & st.depth.count ~= 0 then do do j.depth = 1 to st.depth.count tmp = j.depth /* * Write the referring mail */ call printmail(st.depth.tmp) end end end depth = depth - 1 return /*----------------------------------------------------* * * * Close an index page * * * *----------------------------------------------------*/ closelistfile: /* * Create the page navigation bar */ call writeln(f, '</table><table border=0 width="100%" cellspacing=0 bgcolor="' || titlebgcolor || '"><tr><td><font color="' || titletxcolor || '"> Pages: ') if activepage > 1 then do indexnum = activepage - 1 if indexnum = 1 then indexnum = "" call writeln(f, '<a href="index' || indexnum || '.html">[<<]</a> ') do k = 1 to activepage - 1 indexnum = k if indexnum = 1 then indexnum = "" call writeln(f, '<a href="index' || indexnum || '.html">' || k || '</a> ') end end call writeln(f, activepage || ' ') if activepage < numpages then do do k = activepage + 1 to numpages indexnum = k call writeln(f, '<a href="index' || indexnum || '.html">' || k || '</a> ') end indexnum = activepage + 1 call writeln(f, '<a href="index' || indexnum || '.html">[>>]</a> ') end call writeln(f, '</font></td><td align=right><font color="' || titlebgcolor || '"><font color="' || titletxcolor || '">Created with the <a href="http://www.amigaworld.com/support/fiasco/">Mailing List Archive for Fiasco</a></font></td></tr></table><br>') /* * Add the template file to * the end of the index page */ if open(t, endtemplatefile, "r") then do do while ~eof(t) tln = readln(t) call writeln(f, tln) end call close(t) end call close(f) return /*----------------------------------------------------* * * * Create a new index page * * * *----------------------------------------------------*/ newlistfile: /* * If there is still a index page open, finish it and close it */ if activepage ~= 0 then do call closelistfile end activepage = activepage + 1 indexnum = activepage if indexnum = "1" then indexnum = "" if open(f, dir || "index" || indexnum || ".html", "w") then do /* * Write the template to the start of the * index file */ if open(t, starttemplatefile, "r") then do do while ~eof(t) tln = readln(t) call writeln(f, tln) end call close(t) end call writeln(f, '<!- Created with the Mailing List Archive Database for Fiasco by Nils Bandener (nilsb@amigaworld.com). More Information: http://www.amigaworld.com/support/fiasco ->') call writeln(f, '<table width="100%" border=0 cellspacing=0 cellpadding=2 bgcolor="' || titlebgcolor || '"><tr><td><font color="' || titletxcolor || '" size="+1">' || mlname || ' · Page ' || activepage || ' / ' || numpages || '</font></td><td align=right><font color="' || titletxcolor || '">Last update: ' || date() || '</font></td></tr></table>') call writeln(f, '<table width="100%" border=0 cellspacing=0 cellpadding=2 bgcolor="' || bgcolor || '"><tr>') call writeln(f, '<td bgcolor="' || titlebgcolor || '" colspan=8><font color="' || titletxcolor || '"><b>Subject</b></font></td>') call writeln(f, '<td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '"><b>Size</b></font></td>') call writeln(f, '<td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '"><b>Date</b></font></td>') call writeln(f, '<td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '"><b>From</b></font></td></tr>') end return /*----------------------------------------------------* * * * Create a mail page * * * *----------------------------------------------------*/ writemailfile: if open(m, dir || messagekey || ".html", "w") then do /* * Write the template file to the beginning */ if open(t, starttemplatefile, "r") then do do while ~eof(t) tln = readln(t) call writeln(m, tln) end call close(t) end /* * Write header */ call writeln(m, '<!- Created with the Mailing List Archive Database for Fiasco by Nils Bandener (nils@dinoex.sub.org). More Information: http://www.amigaworld.com/support/fiasco ->') call writeln(m, '<table border=0 cellspacing=0 cellpadding=2 bgcolor="' || bgcolor || '">') call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '"></td><td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '" size="+1">' || mlname || '</font></td></tr>') call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '" align=right><font color="' || titletxcolor || '" size="+1">Subject:</font></td><td><font size="+1">' || subject || '</font></td></tr>') call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '" align=right><font color="' || titletxcolor || '" size="+1">From:</font></td><td><font size="+1"><a href="mailto:' || emailval || '">'|| realname || ' <' || emailval || '></a></font></td></tr>') call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '" align=right><font color="' || titletxcolor || '" size="+1">Date:</font></td><td><font size="+1">' || dateval || '</font></td></tr>') call writeln(m, '</table><br><pre>') p = 1 /* * Convert newlines in the message body to <br> */ do forever p = pos("0A"x, mailbody, p) if p ~= 0 then do mailbody = substr(mailbody, 1, p - 1) || "<br>" || substr(mailbody, p + 1) p = p + 4 end else break end p = 1 do forever p = pos("*n", mailbody, p) if p ~= 0 then do mailbody = substr(mailbody, 1, p - 1) || "<br>" || substr(mailbody, p + 2) p = p + 4 end else break end p = 1 do forever p = pos('*"', mailbody, p) if p ~= 0 then do mailbody = substr(mailbody, 1, p - 1) || '"' || substr(mailbody, p + 2) p = p + 1 end else break end call writeln(m, mailbody || "<br></pre><br>") call writeln(m, '<table border=0 cellspacing=0 cellpadding=2 bgcolor="' || bgcolor || '">') call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '"><font size="+1"><a href="index' || indexnum || '.html"><<</a></font></td><td><font size="+1"><a href="index' || indexnum || '.html">Back</a></font></td></tr></table>') /* * Insert template at the end of the mail page */ if open(t, endtemplatefile, "r") then do do while ~eof(t) tln = readln(t) call writeln(m, tln) end call close(t) end call close(m) /* * Get size of mail page for * index page */ address command 'list >t:chtmp "' || dir || messagekey || '.html" lformat %l' sizeval = "?" if open(m, "t:chtmp", "read") then do sizeval = readln(m) call close(m) end end return